home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
EnigmA Amiga Run 1997 April
/
EnigmA AMIGA RUN 17 (1997)(G.R. Edizioni)(IT)[!][issue 1997-04][EAR-CD].iso
/
EARCD
/
util
/
cli
/
examine.lha
/
Examine1.4
/
Source
/
Examine.e
next >
Wrap
Text File
|
1996-11-20
|
21KB
|
625 lines
/*
** Examine V1.4 r18 15/4/96
** Hand crafted from coffee and chocolate biscuits by Neil Carter
** Public domain 18/11/95
**
** [See how long it takes me to get around to releasing things?!
** This is the (almost) unmodified source for V1.4. If the tone of
** the comments seems 'conversational', it's not because I'm talking
** to you: it's because I'm talking to myself! 8-D
** (Constructive) criticism is welcomed - I'd like some feedback on
** my programming style. I apologise if the long comments don't fit
** on your screen - I'm using a 7x9 font! -Neil]
**
** Don't forget to change version numbers throughout!
**
** The only problem with %h and %o is the way an extra space tends to turn up on the
** end of the string when the length is a multiple of two bytes.
**
** Do I really want to implement %v? *Sigh!*
**
** Probably ought to provide directory scanning (LIST/S), subdirectory recursion (ALL/S)
** and pattern matching on the filename (implicit LIST/S). However, if I do, I'll need to
** rearrange the variable handling a bit. Specifically, some of the global variables will
** need to be made local again (fib, etc.) so I can use recursion. Also, it'll be
** necessary to pass those local variables to the parsetoken() functions and so on.
*/
->Notes
/*
Project description for Examine V1.4 (V2.0?)
Default behaviour, given a filename:
Output "Filename: %n\n
Path: %f\n
Size in bytes: %d\n
Dir entry type: %e\n
FileID name: %s\n
code: %i\n
class: %r\n"
Default behaviour, given no filename:
Output "Examine ?.? r? (?/?/?) written by Neil Carter.
PUBLIC DOMAIN ONLY.
(Template)"
Template:
Examine FILENAME,BRIEF/S,FULL/S,Q=QUICK/S,NOFILEID/S,FORMAT/K,NUMBYTES/K/N,
VERSION/S,ID/S EXE=EXECUTABLE/S,DIR=DIRECTORY/S,WINDOW/S
FILENAME: Obvious
BRIEF: Output "Object %n is %z %s\n"
FULL: Output "Filename: %n\n
Path: %f\n
Comment: %c\n
Datestamp: %t %d\n
Size in bytes: %d\n
Size in blocks: %b\n
Protection: %a\n
Dir entry type: %e\n
Begins with: $%h %o\n
FileID name: %s\n
code: %i\n
class: %r\n"
QUICK: Output "%s"
NOFILEID: Don't use FileID.library (just do an ASCII file check)
FORMAT: Output using the supplied output string
NUMBYTES: Number of bytes for %h and %o to display
VERSION: Output "%v"
ID: Output "%i"
RETURNID: Return RC=ID number
EXECUTABLE: Return RC=5 if FILENAME is an executable
DIRECTORY: Return RC=5 if FILENAME is a directory
WINDOW: Display output in a window instead of through STDOUT
BRIEF, FULL, QUICK, FORMAT, VERSION and ID options are mutually exclusive;
the last one found will be used in case of conflict. NUMBYTES has no effect
if FORMAT is not used. EXECUTABLE, DIRECTORY, or RETURNID can be used with
any other options but are mutually exclusive with one another. Note that
the default is output if only EXECUTABLE, DIRECTORY or RETURNID is used.
Only the default, BRIEF, FULL, QUICK, FORMAT, ID and RETURNID modes open
FileID.library (unless NOFILEID is used).
Options for FORMAT (pretty much the same as List LFORMAT, for simplicity):
%a Protection bits (hsparwed)
%b Size in blocks
%c Comment
%d Date
%e Entry type
%f Full path
%g FileID global file class bits (sfgmiepx)
%h First few bytes hex dump (00000000 00000000)
%i FileID ID code
%k Disk key
%l Size in bytes
%m
%n Filename
%o First few bytes text dump (.... ....)
%p Path as supplied
%q
%r FileID global file class text
%s FileID type name
%t Time
%u
%v Version ($VER:)
%w Weekday
%x
%y
%z "A" or "an" depending on the FileID type name
%% Just print a "%" sign
Other possible ideas:
ALL/S option to cause recursion into subdirectories?
Pattern matching?
*/
->
->>> Compiler
->Modules
MODULE 'dos/dos','dos/datetime', 'fileid', 'libraries/fileid'
->
->Constants
->>> Exceptions
ENUM EX_OK, EX_NO_FILEID, EX_DOS_ERROR, EX_ABOUT, EX_KICK, EX_DFORMAT_WITHOUT_FORMAT
->>> Arguments (don't forget to change NUMARGS below!)
ENUM AFILENAME, ABRIEF, AFULL, AQUICK, ANOFILEID, AFORMAT, ADFORMAT, ANUMBYTES,
ALIST, AALL, AVERSION, AID, ARETURNID, AEXE, ADIR, AWINDOW
->>> ASCII tester
ENUM PURE_ASCII, AMIGA_ASCII, OTHER_ASCII, BINARY, EMPTY_FILE
->>> System
CONST KICKVER=37 -> Any 2.04+ Kickstart
CONST FILEIDVERS=2
->>> Buffer sizes
CONST BUFFER_SIZE=1200, FILENAME_LEN=256, DISKPROGNAME_LEN=110, DESCRIPTION_LEN=36,
OUTPUT_LEN=4096, WHOCARES=1000, DATE_LEN=50,
NUMARGS=16
CONST ARGBUFFER_SIZE=NUMARGS*4
->
->>> Globals
->Globals
DEF fib=NIL:PTR TO fileinfoblock
DEF fidb=NIL:PTR TO fileinfo
DEF buffer=NIL:PTR TO CHAR, length=NIL
DEF lock=NIL, handle=NIL
DEF path:PTR TO CHAR
DEF day=NIL:PTR TO CHAR, date=NIL:PTR TO CHAR, time=NIL:PTR TO CHAR
DEF arguments:PTR TO LONG, rdargs=NIL
DEF isdirectory=FALSE, numbytes=8
->
->>> Procedures
->Main()
PROC main() HANDLE
->>> Build an ENORMOUS stack frame!
DEF fullfilename[FILENAME_LEN]:STRING
DEF diskprogname[DISKPROGNAME_LEN]:STRING
DEF output[OUTPUT_LEN]:STRING -> Should this be on the stack?
DEF longptr:PTR TO LONG, id=NIL:LONG, rc=NIL:LONG
->>> Initialise
IF KickVersion(KICKVER)=FALSE THEN Raise(EX_KICK)
IF GetProgramName(diskprogname, 110)=0 THEN diskprogname:='Examine'
diskprogname:=FilePart(diskprogname)
arguments:=NewR(ARGBUFFER_SIZE)
buffer:=NewR(BUFFER_SIZE)
path:=String(FILENAME_LEN)
->>> Read arguments
IF rdargs:=ReadArgs({template}, arguments, NIL)
StrCopy(fullfilename, arguments[AFILENAME])
ELSE
Raise(EX_DOS_ERROR)
ENDIF
IF arguments[AFILENAME]=NIL THEN Raise(EX_ABOUT) -> No arguments calls version string
IF arguments[ANUMBYTES] THEN numbytes:=Bounds(Long(arguments[ANUMBYTES]), 4, 32)
->>> Load and set up file
IF (lock:=Lock(fullfilename, ACCESS_READ))=0 THEN Raise(EX_DOS_ERROR) -> Lock file
IF Examine(lock, NEW fib) -> Get FileInfoBlock
IF fib.direntrytype<0 -> Is it a file?
IF (handle:=OpenFromLock(lock)) -> Open file
length:=Read(handle, buffer, 1200) -> Get first 1200 bytes
ELSE
Raise(EX_DOS_ERROR)
ENDIF
ELSE
isdirectory:=TRUE -> Mark it as a directory
ENDIF
ELSE
Raise(EX_DOS_ERROR)
ENDIF
StrCopy(path, fullfilename, FilePart(fullfilename)-fullfilename) -> Get path + trailing : or /
->>> Main logic
IF arguments[AID]
formatoutput('%i', output)
ELSEIF arguments[AVERSION]
formatoutput('%v', output)
ELSEIF arguments[AFORMAT]
formatoutput(arguments[
IF (isdirectory) AND (arguments[ADFORMAT]) THEN ADFORMAT ELSE AFORMAT],
output)
ELSEIF arguments[ADFORMAT]
Raise(EX_DFORMAT_WITHOUT_FORMAT)
ELSEIF arguments[AQUICK]
formatoutput('%s', output)
ELSEIF arguments[AFULL]
formatoutput('Filename: %n\n'+
'Path: %f\n'+
'Comment: %c\n'+
'Datestamp: %t %w, %d\n'+
'Size in bytes: %l\n'+
'Size in blocks: %b\n'+
'Protection: %a\n'+
'Dir entry type: %e\n'+
'Begins with: $%h "%o"\n'+
'FileID name: %s\n'+
' code: %i\n'+
' class: %r', output)
ELSEIF arguments[ABRIEF]
formatoutput('Object %n is %z %s', output)
ELSE -> Default
formatoutput('Filename: %n\n'+
'Path: %f\n'+
'Size in bytes: %l\n'+
'Dir entry type: %e\n'+
'FileID name: %s\n'+
' code: %i\n'+
' class: %r', output)
ENDIF
->>> Output the string
IF arguments[AWINDOW]
EasyRequestArgs(NIL, NEW [20, 0, diskprogname, '\s', 'Ok'], NIL, NEW [output])
ELSE
PrintF('\s\n', output)
ENDIF
->>> Exception handler
EXCEPT DO
IF exception=EX_KICK
WriteF('Examine requires Kickstart 2.04 V37+')
CleanUp(RETURN_FAIL) -> Must exit before FreeArgs()!
ENDIF
->>> Free resources
IF fileidbase
IF fidb
id:=fidb.id -> Remember the ID number for later
FiFreeFileInfo(fidb)
ENDIF
CloseLibrary(fileidbase)
ENDIF
IF rdargs THEN FreeArgs(rdargs)
IF handle THEN Close(handle)
IF lock THEN UnLock(lock)
->>> Set return code if requested
IF arguments[ARETURNID]
IF id THEN rc:=id
ELSEIF arguments[ADIR]
IF fib THEN IF fib.direntrytype=2 THEN rc:=RETURN_WARN
ELSEIF arguments[AEXE]
longptr:=buffer
IF longptr[]=$3F3 THEN rc:=RETURN_WARN
ENDIF
->>> Print error messages
IF exception
SELECT exception
CASE "MEM"
PrintFault(ERROR_NO_FREE_STORE, diskprogname)
CASE "fmat"
PrintF('\s: unrecognised token (%\c)\n', diskprogname, exceptioninfo)
CASE EX_NO_FILEID
PrintF('\s: could not open \s version \d+\n', diskprogname, {fileidname}, FILEIDVERS)
CASE EX_DOS_ERROR
PrintFault(IoErr(), diskprogname)
CASE EX_ABOUT
PrintF('\sUsage: \s \s\n', {version}+7, diskprogname, {template}) -> Ace!
CASE EX_DFORMAT_WITHOUT_FORMAT
PrintF('\s: DFORMAT must be used with FORMAT\n', diskprogname)
DEFAULT
PrintF('\s: error\n', diskprogname)
ENDSELECT
CleanUp(RETURN_FAIL)
ENDIF
->>> Quit with correct return code
CleanUp(rc)
ENDPROC
->
->Format Output({format string}, {output string})
/*
** Takes a format string, parses it and writes it to the output string.
*/
PROC formatoutput(format:PTR TO CHAR, output:PTR TO CHAR)
DEF char
WHILE char:=format[]++
SELECT char
CASE "\\" -> That's just _one_ backslash!
IF format[]++="n"
output[]++:=10 -> Stick in an LF
ELSE
output[]++:="\\" -> Not '\n', so print the "\" literally
ENDIF
CASE "%"
output:=parsetoken(format[]++, output)
CASE "¶" -> Might be useful - % clashes with C:List
output:=parsetoken(format[]++, output)
DEFAULT
output[]++:=char
ENDSELECT
ENDWHILE
ENDPROC
->
->Parse Token(token, {output string}) = {new output position} <fmat(char)>
/*
** Given a token and the output string, writes the correct information string
** to the output and updates the pointer.
*/
PROC parsetoken(token, output:PTR TO CHAR)
DEF tempstr[FILENAME_LEN]:STRING, convstr[FILENAME_LEN]:STRING,
char,
bit, bits:PTR TO CHAR,
types:PTR TO CHAR,
byte
SELECT token
CASE "a"
->Protection bits (hsparwed) WORKS!
bits:='----apshdewr----'
FOR bit:=7 TO 0 STEP -1
StrAdd(tempstr, IF fib.protection AND Shl(%1, bit) THEN
bits+bit ELSE bits+bit+8, 1)
ENDFOR
AstrCopy(output, tempstr, WHOCARES)
->
CASE "b"
->Size in blocks WORKS!
IF isdirectory
AstrCopy(output, {notappl}, WHOCARES)
ELSE
AstrCopy(output, StringF(convstr, '\d', fib.numblocks), WHOCARES)
ENDIF
->
CASE "c"
->Comment WORKS!
AstrCopy(output, IF fib.comment[] THEN fib.comment ELSE 'none', WHOCARES)
->
CASE "d"
->Date WORKS!
getdate()
AstrCopy(output, date, WHOCARES)
->
CASE "e"
->Entry type WORKS!
AstrCopy(output, IF fib.direntrytype=-3 THEN 'file' ELSE 'directory', WHOCARES)
->
CASE "f"
->Full path WORKS!
IF NameFromLock(lock, tempstr, FILENAME_LEN)=0 THEN Raise(EX_DOS_ERROR)
AstrCopy(output, tempstr, FilePart(tempstr)-tempstr+1)
->
CASE "g"
->FileID global file class bits (sfgmiepx) WORKS!
IF isdirectory
AstrCopy(output, {notappl}, WHOCARES)
ELSE
dofileid()
bits:='xpeimgfs'
FOR bit:=7 TO 0 STEP -1
StrAdd(tempstr,
IF fidb.globalfileclass AND Shl(%1, bit) THEN bits+bit ELSE '-', 1)
ENDFOR
AstrCopy(output, tempstr, WHOCARES)
ENDIF
->
CASE "h"
->Hex dump WORKS!
IF isdirectory
AstrCopy(output, {notappl}, WHOCARES)
ELSE
FOR byte:=0 TO Min(numbytes, length)-1
IF ((byte AND 1)=FALSE) AND (byte<>0) THEN StrAdd(tempstr, ' ')
StrAdd(tempstr, StringF(convstr, '\z\h[2]', buffer[byte]))
ENDFOR
AstrCopy(output, tempstr, WHOCARES)
ENDIF
->
CASE "i"
->FileID ID code WORKS!
IF isdirectory
AstrCopy(output, {notappl}, WHOCARES)
ELSE
dofileid()
AstrCopy(output, StringF(convstr, '\d', fidb.id), WHOCARES)
ENDIF
->
CASE "k"
->Disk key WORKS!
AstrCopy(output, StringF(convstr, '\d', fib.diskkey), WHOCARES)
->
CASE "l"
->Size in bytes WORKS!
IF isdirectory
AstrCopy(output, {notappl}, WHOCARES)
ELSE
AstrCopy(output, StringF(convstr, '\d', fib.size), WHOCARES)
ENDIF
->
CASE "n"
->Filename WORKS!
AstrCopy(output, fib.filename, WHOCARES)
->
CASE "o"
->ASCII dump WORKS!
IF isdirectory
AstrCopy(output, {notappl}, WHOCARES)
ELSE
FOR byte:=0 TO Min(numbytes, length)-1
-> IF ((byte AND 1)=FALSE) AND (byte<>0) THEN StrAdd(tempstr, ' ')
StrAdd(tempstr, StringF(convstr, '\c',
IF (buffer[byte]<" ") OR
((buffer[byte]>=$80) AND (buffer[byte]<$A0))
THEN "." ELSE buffer[byte]))
-> I'll have precedence with my logic operators pahleeese!
ENDFOR
AstrCopy(output, tempstr, WHOCARES)
ENDIF
->
CASE "p"
->Supplied path WORKS!
AstrCopy(output, path, WHOCARES)
->
CASE "r"
->FileID global file class text WORKS!
IF isdirectory
AstrCopy(output, {notappl}, WHOCARES)
ELSE
dofileid()
types:=['(Executable)', '(Packed)', '(Encrypted)', '(IFF)',
'(Music)', '(Graphics)', '(Text)', '(Script)']
IF fidb.globalfileclass=0
StrCopy(tempstr, '(None)')
ELSE
FOR bit:=0 TO 7
IF fidb.globalfileclass AND Shl(%1, bit) THEN
StrAdd(tempstr, ListItem(types, bit))
ENDFOR
ENDIF
AstrCopy(output, tempstr, WHOCARES)
ENDIF
->
CASE "s"
->FileID type name WORKS!
AstrCopy(output, describe(), WHOCARES)
->
CASE "t"
->Time WORKS!
getdate()
AstrCopy(output, time, WHOCARES)
->
CASE "v"
->Version (not implemented yet)
IF isdirectory
AstrCopy(output, {notappl}, WHOCARES)
ELSE
AstrCopy(output, 'version not implemented', WHOCARES)
ENDIF
->
CASE "w"
->Weekday WORKS!
getdate()
AstrCopy(output, day, WHOCARES)
->
CASE "z"
->'a' or 'an', depending on the first letter of %s WORKS!
dofileid()
char:=Char(describe()) AND %1011111 -> Uppercase the initial letter
AstrCopy(output, IF (char="A") OR (char="E") OR (char="I") OR
(char="O") OR (char="U") THEN 'an' ELSE 'a', WHOCARES)
-> Oooh! Fussy! ;-)
->
CASE "%"
->Percent sign WORKS!
AstrCopy(output, '%', WHOCARES) -> What a waste!
->
CASE "¶"
->Paragraph mark WORKS!
AstrCopy(output, '¶', WHOCARES)
->
DEFAULT
Throw("fmat", token) -> Unused token
ENDSELECT
output:=output+StrLen(output) -> Update the pointer
ENDPROC output
->
->GetDate()
PROC getdate()
DEF datetime:datetime
IF day=NIL
datetime.stamp.days:=fib.datestamp.days
datetime.stamp.minute:=fib.datestamp.minute
datetime.stamp.tick:=fib.datestamp.tick
datetime.format:=FORMAT_DOS
datetime.flags:=DTF_SUBST
datetime.strday:=day:=String(DATE_LEN)
datetime.strdate:=date:=String(DATE_LEN)
datetime.strtime:=time:=String(DATE_LEN)
DateToStr(datetime)
ENDIF
ENDPROC
->
->Do FileID()
/*
** Just opens FileID.library and uses it to scan the file. If that's already been
** done, it does nothing.
*/
PROC dofileid()
IF fidb OR arguments[ANOFILEID] THEN RETURN
IF fib.direntrytype<0 -> Don't bother if it's a directory
IF (fileidbase:=OpenLibrary({fileidname}, FILEIDVERS))=NIL THEN Raise(EX_NO_FILEID)
IF (fidb:=FiAllocFileInfo())=NIL THEN Raise("MEM") -> Allocate info data structure
FiIdentify(buffer, fidb) -> Examine buffer
ENDIF
ENDPROC
->
->Describe() = description
/*
** NOTE: if the %s token turns up more than once (it might!), the file may be
** examinebinary()ed each time.
*/
PROC describe()
DEF description:PTR TO CHAR
dofileid()
description:=String(DESCRIPTION_LEN) -> Freed on CleanUp()
IF (fidb.id=0) OR (fidb=NIL)
examinebinary(description)
ELSE
description:=fidb.description
ENDIF
ENDPROC description
->
-> Examine Binary({description string})
PROC examinebinary(description)
DEF a, type
IF isdirectory
StrCopy(description, 'directory')
RETURN
ENDIF
IF length>0
type:=PURE_ASCII
FOR a:=0 TO length-1
IF buffer[a]=0 -> Kludge! $0s in file = binary
type:=Max(type, BINARY)
ELSEIF (buffer[a]>127) AND (buffer[a]<160) -> Amiga control character range
type:=Max(type, OTHER_ASCII)
ELSEIF (buffer[a]>=160) -> Amiga extended character range
type:=Max(type, AMIGA_ASCII)
ENDIF
ENDFOR
ELSE
type:=EMPTY_FILE
ENDIF
StrCopy(description, ListItem(['pure ASCII text file',
'Amiga ASCII text file',
'unknown ASCII text file',
'unknown data file', -> perhaps should be 'binary file'?
'empty file'], type))
ENDPROC
->
->>> Static data
-> Version
-> Standard version string for c:version. "Version Examine FULL" will return the author string.
version:
CHAR 0, '$VER: Examine 1.4 (14/5/96) written by Neil Carter.\nPUBLIC DOMAIN ONLY.\n', 0
->
->Template
template:
CHAR 'FILENAME,BRIEF/S,FULL/S,Q=QUICK/S,NOFILEID/S,FORMAT/K,DFORMAT/K,NUMBYTES/K/N,LIST/S,ALL/S,VERSION/S,ID/S,RETURNID/S,EXE=EXECUTABLE/S,DIR=DIRECTORY/S,WINDOW/S', 0
->
->FileID name
fileidname:
CHAR 'FileID.library', 0
->
->Not Applicable
notappl:
CHAR 'N/A', 0
->